home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d12 / bob13.arc / BOBFCN.C < prev    next >
Encoding:
C/C++ Source or Header  |  1991-10-02  |  5.8 KB  |  274 lines
  1. /* bobfcn.c - built-in classes and functions */
  2. /*
  3.     Copyright (c) 1991, by David Michael Betz
  4.     All rights reserved
  5. */
  6.  
  7. #include "bob.h"
  8.  
  9. /* argument check macros */
  10. #define argcount(n,cnt)    { if ((n) < (cnt)) toomany(); \
  11.               else if ((n) > (cnt)) toofew(); }
  12.  
  13. /* external variables */
  14. extern VALUE symbols;
  15.  
  16. /* forward declarations */
  17. int xtypeof();
  18. int xnewvector(),xnewstring(),xsizeof(),xprint(),xgetarg(),xsystem();
  19. int xfopen(),xfclose(),xgetc(),xputc();
  20.  
  21. /* init_functions - initialize the internal functions */
  22. void init_functions()
  23. {
  24.     add_file("stdin",stdin);
  25.     add_file("stdout",stdout);
  26.     add_file("stderr",stderr);
  27.     add_function("typeof",xtypeof);
  28.     add_function("newvector",xnewvector);
  29.     add_function("newstring",xnewstring);
  30.     add_function("sizeof",xsizeof);
  31.     add_function("fopen",xfopen);
  32.     add_function("fclose",xfclose);
  33.     add_function("getc",xgetc);
  34.     add_function("putc",xputc);
  35.     add_function("print",xprint);
  36.     add_function("getarg",xgetarg);
  37.     add_function("system",xsystem);
  38. }
  39.  
  40. /* add_function - add a built-in function */
  41. static add_function(name,fcn)
  42.   char *name; int (*fcn)();
  43. {
  44.     DICT_ENTRY *sym;
  45.     sym = addentry(&symbols,name,ST_SFUNCTION);
  46.     set_code(&sym->de_value,fcn);
  47. }
  48.  
  49. /* add_file - add a built-in file */
  50. static add_file(name,fp)
  51.   char *name; FILE *fp;
  52. {
  53.     DICT_ENTRY *sym;
  54.     sym = addentry(&symbols,name,ST_SDATA);
  55.     set_file(&sym->de_value,fp);
  56. }
  57.  
  58. /* xtypeof - get the data type of a value */
  59. static int xtypeof(argc)
  60.   int argc;
  61. {
  62.     argcount(argc,1);
  63.     set_integer(&sp[1],sp->v_type);
  64.     ++sp;
  65. }
  66.  
  67. /* xnewvector - allocate a new vector */
  68. static int xnewvector(argc)
  69.   int argc;
  70. {
  71.     int size;
  72.     argcount(argc,1);
  73.     chktype(0,DT_INTEGER);
  74.     size = sp->v.v_integer;
  75.     set_vector(&sp[1],newvector(size));
  76.     ++sp;
  77. }
  78.  
  79. /* xnewstring - allocate a new string */
  80. static int xnewstring(argc)
  81.   int argc;
  82. {
  83.     int size;
  84.     argcount(argc,1);
  85.     chktype(0,DT_INTEGER);
  86.     size = sp->v.v_integer;
  87.     set_string(&sp[1],newstring(size));
  88.     ++sp;
  89. }
  90.  
  91. /* xsizeof - get the size of a vector or string */
  92. static int xsizeof(argc)
  93.   int argc;
  94. {
  95.     argcount(argc,1);
  96.     switch (sp->v_type) {
  97.     case DT_VECTOR:
  98.     set_integer(&sp[1],sp->v.v_vector->vec_size);
  99.     break;
  100.     case DT_STRING:
  101.     set_integer(&sp[1],sp->v.v_string->str_size);
  102.     break;
  103.     default:
  104.     break;
  105.     }
  106.     ++sp;
  107. }
  108.  
  109. /* xfopen - open a file */
  110. static int xfopen(argc)
  111.   int argc;
  112. {
  113.     char name[50],mode[10];
  114.     FILE *fp;
  115.     argcount(argc,2);
  116.     chktype(0,DT_STRING);
  117.     chktype(1,DT_STRING);
  118.     getcstring(name,sizeof(name),&sp[1]);
  119.     getcstring(mode,sizeof(mode),&sp[0]);
  120.     if ((fp = fopen(name,mode)) == NULL)
  121.     set_nil(&sp[2]);
  122.     else
  123.     set_file(&sp[2],fp);
  124.     sp += 2;
  125. }
  126.  
  127. /* xfclose - close a file */
  128. static int xfclose(argc)
  129.   int argc;
  130. {
  131.     argcount(argc,1);
  132.     chktype(0,DT_FILE);
  133.     set_integer(&sp[1],fclose(sp[0].v.v_fp));
  134.     ++sp;
  135. }
  136.  
  137. /* xgetc - get a character from a file */
  138. static int xgetc(argc)
  139.   int argc;
  140. {
  141.     argcount(argc,1);
  142.     chktype(0,DT_FILE);
  143.     set_integer(&sp[1],getc(sp[0].v.v_fp));
  144.     ++sp;
  145. }
  146.  
  147. /* xputc - output a character to a file */
  148. static int xputc(argc)
  149.   int argc;
  150. {
  151.     argcount(argc,2);
  152.     chktype(0,DT_FILE);
  153.     chktype(1,DT_INTEGER);
  154.     set_integer(&sp[2],putc(sp[1].v.v_integer,sp[0].v.v_fp));
  155.     sp += 2;
  156. }
  157.  
  158. /* xprint - generic print function */
  159. static int xprint(argc)
  160.   int argc;
  161. {
  162.     int n;
  163.     for (n = argc; --n >= 0; )
  164.     print1(stdout,FALSE,&sp[n]);
  165.     sp += argc;
  166.     set_nil(sp);
  167. }
  168.  
  169. /* print1 - print one value */
  170. print1(fp,qflag,val)
  171.   FILE *fp; int qflag; VALUE *val;
  172. {
  173.     char name[TKNSIZE+1],buf[200],*p;
  174.     VALUE *class;
  175.     int len;
  176.     switch (val->v_type) {
  177.     case DT_NIL:
  178.     fputs("nil",fp);
  179.     break;
  180.     case DT_CLASS:
  181.     getcstring(name,sizeof(name),clgetname(val));
  182.     sprintf(buf,"#<Class-%s>",name);
  183.     fputs(buf,fp);
  184.     break;
  185.     case DT_OBJECT:
  186.     sprintf(buf,"#<Object-%lx>",objaddr(val));
  187.     fputs(buf,fp);
  188.     break;
  189.     case DT_VECTOR:
  190.     sprintf(buf,"#<Vector-%lx>",vecaddr(val));
  191.     fputs(buf,fp);
  192.     break;
  193.     case DT_INTEGER:
  194.     sprintf(buf,"%ld",val->v.v_integer);
  195.     fputs(buf,fp);
  196.     break;
  197.     case DT_STRING:
  198.     if (qflag) putc('"',fp);
  199.     p = strgetdata(val);
  200.     len = strgetsize(val);
  201.     while (--len >= 0)
  202.         putc(*p++,fp);
  203.     if (qflag) putc('"',fp);
  204.     break;
  205.     case DT_BYTECODE:
  206.     sprintf(buf,"#<Bytecode-%lx>",vecaddr(val));
  207.     fputs(buf,fp);
  208.     break;
  209.     case DT_CODE:
  210.     sprintf(buf,"#<Code-%lx>",val->v.v_code);
  211.     fputs(buf,fp);
  212.     break;
  213.     case DT_VAR:
  214.     class = digetclass(degetdictionary(val));
  215.     if (!isnil(class)) {
  216.         getcstring(name,sizeof(name),clgetname(class));
  217.         sprintf(buf,"%s::",name);
  218.         fputs(buf,fp);
  219.     }
  220.     getcstring(name,sizeof(name),degetkey(val));
  221.     fputs(name,fp);
  222.     break;
  223.     case DT_FILE:
  224.     sprintf(buf,"#<File-%lx>",val->v.v_fp);
  225.     fputs(buf,fp);
  226.     break;
  227.     default:
  228.     error("Undefined type: %d",valtype(val));
  229.     }
  230. }
  231.  
  232. /* xgetarg - get an argument from the argument list */
  233. static int xgetarg(argc)
  234.   int argc;
  235. {
  236.     extern char **bobargv;
  237.     extern int bobargc;
  238.     int i;
  239.     argcount(argc,1);
  240.     chktype(0,DT_INTEGER);
  241.     i = sp[0].v.v_integer;
  242.     if (i >= 0 && i < bobargc)
  243.     set_string(&sp[1],makestring(bobargv[i]));
  244.     else
  245.     set_nil(&sp[1]);
  246.     ++sp;
  247. }
  248.  
  249. /* xsystem - execute a system command */
  250. static int xsystem(argc)
  251.   int argc;
  252. {
  253.     char cmd[133];
  254.     argcount(argc,1);
  255.     chktype(0,DT_STRING);
  256.     getcstring(cmd,sizeof(cmd),&sp[0]);
  257.     set_integer(&sp[1],system(cmd));
  258.     ++sp;
  259. }
  260.  
  261. /* toofew - too few arguments */
  262. static int toofew()
  263. {
  264.     error("Too few arguments");
  265.     return (FALSE);
  266. }
  267.  
  268. /* toomany - too many arguments */
  269. static int toomany()
  270. {
  271.     error("Too many arguments");
  272.     return (FALSE);
  273. }
  274.